home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0585.arc / BMLP.DOC < prev    next >
Text File  |  1986-02-27  |  58KB  |  1,781 lines
  1.  
  2.  
  3.                 BMLP MACRO LANGUAGE PREPROCESSOR
  4.  
  5.  
  6.  
  7.     INTRODUCTION 
  8.  
  9.          BMLP and BSLP  are  preprocessor  tools for  Microsoft BASIC.
  10.          
  11.          BMLP is a macro language preprocessor. It allows you to write 
  12.          your programs using macros which you define in the program or 
  13.          within macro library text files.  
  14.          
  15.          BSLP  takes  a  source  file  containing  special  structured 
  16.          statements and translates it into a program containing  BASIC 
  17.          statements.  
  18.          
  19.          Using these tools will help you write  more  concise,  better
  20.          structured BASIC programs,  by allowing you to take advantage
  21.          of these features:
  22.          
  23.          - program  with macros  using parameters and subroutines that
  24.            are  maintained in  libraries where they can be accessed by 
  25.            all your programs.  
  26.          
  27.          - write free-form, indented statements without  line  numbers.  
  28.  
  29.          - include statements from many separate files  and  libraries 
  30.            into  a  single  BASIC  program.  (This lets  you write and 
  31.            maintain your programs in small modules.)  
  32.  
  33.          - organize your subroutines into procedures,  each  with  its 
  34.            own descriptive alpha-numeric name.  
  35.  
  36.          - structure  your programming  with multi-line  conditionals,
  37.            loop  and  case   constructs  similar  to  those  found  in 
  38.            programming languages like C and Pascal.  
  39.  
  40.          When using these preprocessors,  please  bear  in  mind  that 
  41.          these versions are written in BASIC and are provided for your 
  42.          use and you are free to modify them in any manner you see fit.  
  43.          
  44.          If you find these tools useful, we have a package called  PPE 
  45.          (Professional Programming Environment) that  includes a super 
  46.          preprocessor   (SLPC)  which  is  written  in  C  for  faster 
  47.          processing  (300-400  lines/min).  It  does  everything  that 
  48.          these  do PLUS a lot more,  like providing a define statement 
  49.          for text substitution and built-in random file handling macro 
  50.          statements.  It comes with a large library of  macros  and  a 
  51.          library manager program.  
  52.          
  53.          If  you have suggestions,  questions,  comments or would like 
  54.          more information about the PPE package, 
  55.          please contact us at:è
  56.                  Bendorf Associates
  57.                  P.O. Box 5910
  58.                  6006 S. Main
  59.                  Roswell, NM 88201
  60.                  (505) 347-5701
  61.         
  62.          The following is a list  and  brief  abstract of the files on
  63.          this disk:           
  64.  
  65.          Files for BSLP: Basic Structured Language Preprocessor 
  66.  
  67.            BSLP.P . . . . . . . Structured Language Source Text
  68.            BSLP.BAS . . . . . . Microsoft Basic Source Code
  69.            BSLP.DOC . . . . . . Documentation
  70.            BSLP.MSD . . . . . . MS-DOS Compiled Version (.EXE)
  71.            BSLP.CPM . . . . . . CP/M 80 Compiled Version (.COM)
  72.  
  73.          Files for BMLP: Basic Macro Language Preprocessor
  74.  
  75.            BMLP.P . . . . . . . Structured Language Source Text
  76.            BMLP.BAS . . . . . . Microsoft Basic Source Code
  77.            BMLP.DOC . . . . . . Documentation
  78.            BMLP.MSD . . . . . . MS-DOS Compiled Version (.EXE)
  79.            BMLP.CPM . . . . . . CP/M 80 Compiled Version (.COM)
  80.  
  81.          Files for BSLP & BMLP example programs
  82.  
  83.            XFRAME.M . . . . . . Example Program Source Text
  84.            XFRAME.ML  . . . . . Library for XFRAME.M
  85.            BINPUT.M . . . . . . Example Program Source Text
  86.            BINPUT.ML  . . . . . Library for BINPUT.M
  87.  
  88.  
  89. BMLP.DOC
  90.  
  91.        Function
  92.  
  93.          BMLP  expands macro expressions using program resident and/or 
  94.          library file macro definitions.  BMLP  is  written  in  'SSS' 
  95.          language and should be a useful learning tool.  
  96.  
  97.     
  98.        Invocation
  99.  
  100.          Entering 'BMLP' at the DOS prompt will  envoke  the  compiled 
  101.          version  (.EXE)  of BMLP.  The (.BAS) version will have to be 
  102.          run using the interpreter by entering 'BASICA  BMLP'  at  the 
  103.          DOS  prompt.  BMLP  will  then prompt for the input file name 
  104.          and the output file name.  The default  for  the  input  file 
  105.          extension  is '.M',  and the default for the output file name 
  106.          is the input file name with the extension of '.P'.  
  107.  
  108.  
  109.        Formats è
  110.             Macro expression format: 
  111.  
  112.                  $macro-name param1,param2,param3 
  113.          
  114.          A leading dollar sign ($) is used to identify  a  macro  name 
  115.          and,  except for spaces and tabs, must be the first character 
  116.          on  the  line.   When  parameters  are  used,  they  must  be 
  117.          separated by a comma, tab, or space;  when there are too many 
  118.          to put on one line,  a double backslash (\\) may be  used  to 
  119.          continue on the next line.  
  120.  
  121.  
  122.             Macro coding format:
  123.  
  124.                  MACRO <macro-name>
  125.                  ENDM
  126.              
  127.          Macros  are  written and maintained with a text editor in one 
  128.          or more library  text  files  and/or  program  source  files.  
  129.          Macro  names may contain any combination of characters except 
  130.          commas,   tabs,   and  spaces,   and   there   is   no   case 
  131.          discrimination.  The  keyword  'MACRO'  is used to identify a 
  132.          macro name and the beginning of code  for  that  macro  name.  
  133.          The  keyword  'ENDM'  identifies  the end of code for a macro 
  134.          name.  Within the macro code a number enclosed with  brackets 
  135.          ([])  identifies  a  parameter request.  A leading semi-colon 
  136.          (;) may be used as a comment character.  Macros may use other 
  137.          macros as  well  as  supporting  subroutines  (more  on  this 
  138.          later).  
  139.  
  140. 
  141.  
  142.        Design
  143.  
  144.  
  145.          Writing macros is easy, fun and can be habit forming once you 
  146.          get  the  hang  of  it.  To demonstrate let's take the simple 
  147.          task of displaying text on the video monitor.  The  following 
  148.          list of operations describes this task in detail: 
  149.          
  150.  
  151.             1. Save the current cursor location.
  152.             2. Turn off and re-position the cursor.
  153.             3. Clear a space the size of the text.
  154.             4. Re-position the cursor.
  155.             5. Display the text.
  156.             6. Restore cursor location and turn it on.
  157.  
  158.  
  159.          BASIC code for this example might be:
  160.  
  161.             100 XR%=CSRLIN:XC%=POS(0)
  162.                 :LOCATE,,0:LOCATE ROW,COL
  163.                 :PRINT SPACE$(LEN(TEXT$));
  164.                 :LOCATE ROW,COL
  165.                 :PRINT TEXT$;
  166.                 :LOCATE XR%,XC%,1
  167.       
  168.          A macro expression for the above example:
  169.       
  170.             $CRT ROW,COL,TEXT$
  171.             /--- -------------\
  172.             Macro Name         Parameter List
  173.       
  174.          Code for the 'CRT' macro could be written like this:
  175.       
  176.             MACRO CRT
  177.                XR%=CSRLIN:XC%=POS(0)
  178.                LOCATE,,0:LOCATE [1],[2],0:PRINT SPACE$(LEN([3]));
  179.                LOCATE [1],[2],0:PRINT [3];:LOCATE XR%,XC%,1
  180.             ENDM
  181. 
  182.  
  183.       
  184.          The  parameters  are  numbered in left to right order as they 
  185.          appear in the list following the 'CRT' macro, e.g.; 
  186.  
  187.  
  188.             [1] = ROW     <parameter one>
  189.             [2] = COL     <parameter two>
  190.             [3] = TEXT$   <parameter three>
  191.  
  192.          Parameters  can  be  passed  using   variables   or   literal 
  193.          expressions: 
  194.  
  195.             $CRT 12,10,"Hello World!"
  196.  
  197.  
  198.  
  199.        Nesting Macros
  200.   
  201.          Because  a  macro  can use other macros (nesting),  the 'CRT' 
  202.          macro can also be written using macros for the  required  six 
  203.          functions.  
  204.  
  205.  
  206.             1. Save the current cursor location. ------+
  207.             |  MACRO SVC                               |
  208.             |      [1]=CSRLIN:[2]=POS(0)               |
  209.             |  ENDM                                    |
  210.             +------------------------------------------+
  211.  
  212.             2. Position the cursor and switch on/off. -+
  213.             |  MACRO XY                                |
  214.             |      LOCATE [1],[2],[3]                  |
  215.             |  ENDM                                    |
  216.             +------------------------------------------+
  217.  
  218.             3. Clear a space the size of the text. ----+
  219.             |  MACRO CLR                               |
  220.             |      PRINT SPACE$([1]);                  |
  221.             |  ENDM                                    |
  222.             +------------------------------------------+
  223.  
  224.             4. Re-position the cursor. ----------------+
  225.             |  (Use the XY macro, (2))                 |
  226.             +------------------------------------------+
  227.  
  228.             5. Display the text. ----------------------+
  229.             |  MACRO SHO                               |
  230.             |      PRINT [1];                          |
  231.             |  ENDM                                    |
  232.             +------------------------------------------+
  233.  
  234.             6. Restore cursor location, turn it on. ---+ 
  235.             |  (Again use the XY macro, (2))           |è            +------------------------------------------+
  236. 
  237.  
  238.          Now the 'CRT' macro can be written using the four new macros:
  239.  
  240.             MACRO CRT                
  241.                 $SVC XR%,XC% 
  242.                 $XY ,,0
  243.                 $XY [1],[2],0
  244.                 $CLR LEN([3])
  245.                 $XY [1],[2],0
  246.                 $SHO [3]
  247.                 $XY XR%,XC%,1
  248.             ENDM
  249.                 
  250.          Writing  macros  for  the  lower level functions of the 'CRT' 
  251.          macro provides  several  benefits,  one  of  them  being  the 
  252.          availability  of  lower  level  macros  to be used in writing 
  253.          other higher level macros.  
  254.  
  255.  
  256.        Conditional Logic
  257.  
  258.             $IF / $ELSE / $END
  259.     
  260.          '$IF-$ELSE-$END' are reserved macro keywords that provide the 
  261.          ability to control the inclusion or expansion of segments  of 
  262.          code  within  a  macro.  The 'CRT' macro can be enhanced with 
  263.          added ability to display the text in reverse video.  This  is 
  264.          easily  implemented  using a fourth parameter and conditional 
  265.          logic to control the inclusion of the "COLOR" statement.  
  266.  
  267.  
  268.             MACRO CRT
  269.                 $SVC XR%,XC%
  270.                 $XY ,,0
  271.                 $XY [1],[2],0
  272.                 $CLR LEN([3])
  273.                 $XY [1],[2],0
  274.                 $IF [4]     <--+  If fourth parameter ([4]) is provided
  275.                 COLOR 0,7      |  then the statement 'COLOR 0,7' will
  276.                 $END        <--+  be included. (Reverse)
  277.                 $SHO [3]
  278.                 $IF [4]     <--+  If fourth parameter ([4]) is provided
  279.                 COLOR 7,0      |  then the statement 'COLOR 7,0' will
  280.                 $END        <--+  be included. (Reset to Normal)
  281.                 $XY XR%,XC%,1
  282.             ENDM
  283. 
  284.  
  285.          Example:
  286.  
  287.             $CRT 12,10,"Hello World!",REV
  288.                                         \..(fourth parameter)
  289.             (Display "Hello World!" at row 12, column 10, in reverse video.)
  290.  
  291.             $CRT 12,10,"Hello World!"
  292.                                         \..(missing fourth parameter)
  293.             (Display "Hello World!" at row 12, column 10, in normal video.)
  294.   
  295.  
  296.  
  297.        Logical Operators
  298.  
  299.          The 'equal-to (=)' and the 'not-equal (#)  or  (<>)'  logical 
  300.          operators  can  be  used  to  test  literal  parameters for a 
  301.          specific value, e.g.; 
  302.       
  303.  
  304.             $IF [1] = 1
  305.             $IF [6] # NOERROR
  306.             $IF [4] = REV
  307.                     \
  308.                     (Operators must to be separated by spaces or tabs.)
  309.  
  310.          'CRT' macro with logical operators: 
  311.  
  312.             MACRO CRT
  313.                 $SVC XR%,XC%
  314.                 $XY ,,0
  315.                 $XY [1],[2],0
  316.                 $CLR LEN([3])
  317.                 $XY [1],[2],0
  318.                 $IF [4] = REV  <--+  If fourth parameter ([4]) EQUALS "REV"
  319.                 COLOR 0,7         |  then the statement 'COLOR 0,7' will
  320.                 $END           <--+  be included. (Reverse)
  321.                 $SHO [3]
  322.                 $IF [4] # NORM <--+  If fourth parameter ([4]) NOT EQUAL "NORM"
  323.                 COLOR 7,0         |  then the statement 'COLOR 7,0' will
  324.                 $END           <--+  be included. (Reset to Normal)
  325.                 $XY XR%,XC%,1
  326.             ENDM
  327.  
  328.          Example:
  329.  
  330.             $CRT 12,10,"Hello World!",REV
  331.                                         \..(fourth parameter)
  332.             (Display "Hello World!" at row 12, column 10, in reverse video.)
  333.  
  334.             $CRT 12,10,"Hello World!",NORM
  335.                                         \..(fourth parameter)
  336.             (Display "Hello World!" at row 12, column 10, in normal video.)
  337. 
  338.  
  339.        Macros and Subroutines
  340.  
  341.          One of the more powerful features of macro programming is the 
  342.          ability to write macros that require supporting  subroutines.  
  343.          This  ability  allows  the use of a macro any number of times 
  344.          within a program,  with only one inclusion of its  supporting 
  345.          subroutine.  Thus, blocks of duplicated code are eliminated.  
  346.  
  347.  
  348.          An example is the operation of stripping leading and trailing 
  349.          space and tab characters from a string of text: 
  350.  
  351.       
  352.          $STRIP TEXT$
  353.       
  354.          The code for 'STRIP' macro:------+
  355.          MACRO STRIP                      |
  356.              X$=[1]:Gosub _Stripit:[1]=X$ |
  357.              $$_STRIP                     |
  358.          ENDM                             |
  359.          ---------------------------------+
  360.        
  361.          The code for '_STRIP' supporting subroutine:----------------+
  362.          MACRO _STRIP                                                |
  363.          proc _Stripit                                               |
  364.              unless LEN(X$)<3                                        |
  365.                  X%=LEN(X$)+1                                        |
  366.                  WHILE(X%>LEN(X$) AND LEN(X$)>2)                     |
  367.                      X%=LEN(X$)                                      |
  368.                      X$=LEFT$(X$,LEN(X$)+(RIGHT$(X$,1)=" "))         |
  369.                      X$=LEFT$(X$,LEN(X$)+(ASC(RIGHT$(X$,1))=9))      |
  370.                      X$=RIGHT$(X$,LEN(X$)+(ASC(X$)=32 OR ASC(X$)=9)) |
  371.                  WEND                                                |
  372.              endu                                                    |
  373.          endp                                                        |
  374.          ENDM                                                        |
  375.          ------------------------------------------------------------+
  376.               
  377.          The  leading  double  dollar sign ($$) identify '_STRIP' as a 
  378.          subroutine which is defined as a procedure (_Stripit) and  it 
  379.          will be included into a program source file only one time.  A 
  380.          subroutine may include and use other subroutines and macros.  
  381.  
  382. 
  383.  
  384.        Developing Libraries
  385.  
  386.          Macros can be written within a  program  source  file,  where 
  387.          they can be easily tested and debugged before being committed 
  388.          to  a  library  file.   Library  documentation  is  extremely 
  389.          important.  After  writing  a  couple  of  dozen  macros,  it 
  390.          becomes  a  little  more  difficult  to remember function and 
  391.          parameter requirements for each macro.  The ability to  share 
  392.          libraries  among  several  programmers  working  on  the same 
  393.          project makes the library documentation essential.  
  394.  
  395.  
  396.        Using Libraries
  397.  
  398.             LIBRARY <file-name.ext>
  399.  
  400.          The keyword 'LIBRARY' is used at the top of a program  source 
  401.          file to identify each macro library to use in processing that 
  402.          source  file.  Libraries can be nested by specifing libraries 
  403.          within libraries.  
  404.  
  405.  
  406. BMLP.BAS
  407.  
  408. 100 SIGN$    = "$"
  409. 101 DOT$     = "."
  410. 102 OEXT$    = ".P"         ' Output file default extension
  411. 103 IEXT$    = ".M"         ' Input file default extension
  412. 104 LEXT$    = ".ML"        ' Library file default extension
  413. 105 SOURCE%  = 2            ' Input file number
  414. 106 O.FILE%  = 1            ' Output file number
  415. 107 I.FILE%  = 2
  416. 108 ERRORS%  = 0
  417. 109 FALSE%   = 0
  418. 110 TRUE%    = NOT FALSE%
  419. 111 EXPAND%  = TRUE%
  420. 112 STORE.%  = 0
  421. 113 NEST%    = 1
  422. 114 DIM FILE.%(50)      ' TEMPORARY STACK OF POINTERS TO THE NEXT SUBSCRIPT
  423. 115 DIM PARM$(500)      ' TEMPORARY STORAGE OF PARAMETERS TO PASS TO MACROS.
  424. 116 DIM PARM%(100)      ' ARRAY OF POINTERS TO PARAMETER STORAGE.
  425. 117 DIM MACRO$(100)     ' STORAGE FOR MACRO NAMES.
  426. 118 DIM MACRO%(100)     ' ARRAY OF POINTERS TO FIRST CODE LOCATION IN STORE$ ARRAY
  427. 119 DIM STORE$(1000)    ' STORAGE FOR MACRO TEXT.
  428. 120 DIM SUBS$(50)       ' STORAGE FOR MACRO SUBROUTINE NAMES.
  429. 121 PRINT "BMLP   V1.0B (C) BENDORF ASSOCIATES, 1984-85"
  430. 122 PRINT
  431. 123 GoSub 354
  432. 124 IF NOT(I.FILE%>0) GOTO 133
  433. 125 GoSub 137
  434. 126 CLOSE
  435. 127 IF NOT(ERRORS%>0) GOTO 131
  436. 128 KILL O.FILE$è129 PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  437. 130 GOTO 132
  438. 131 PRINT"<";O.FILE$;"> DONE!"
  439. 132 GOTO 135
  440. 133 IF NOT(I.FILE$<>"") GOTO 135
  441. 134 PRINT"CANNOT OPEN ";I.FILE$
  442. 135 END
  443. 136     'PROCESS-SOURCE-FILE
  444. 137 OPEN"O",O.FILE%,O.FILE$
  445. 138 OPEN"I",I.FILE%,I.FILE$
  446. 139 FILE.%(NEST%)=-1
  447. 140 IF(NEST%=0) GOTO 175
  448. 141 while ENDOFF%=FALSE%
  449. 142 GoSub 267
  450. 143 IF NOT(LN.%>1 AND ENDOFF%=FALSE%) GOTO 147
  451. 144 GoSub 207
  452. 145 GoSub 177
  453. 146 GOTO 149
  454. 147 IF NOT(SKIP% AND I.FILE%=SOURCE%) GOTO 149
  455. 148 PRINT #O.FILE%,BUF$
  456. 149 wend
  457. 150 IF(NEST%=1)THEN FIRST%=0 ELSE FIRST%=PARM%(NEST%-1)
  458. 151 LAST%=PARM%(NEST%)
  459. 152 PARM%(NEST%)=0
  460. 153 while (FIRST%<LAST%)
  461. 154 PARM$(LAST%)=""
  462. 155 LAST%=LAST%-1
  463. 156 wend
  464. 157 IF NOT(FILE.%(NEST%)<0 AND NEST%>1 AND I.FILE%>SOURCE%) GOTO 161
  465. 158 CLOSE #I.FILE%
  466. 159 I.FILE%=I.FILE%-1
  467. 160 GOTO 162
  468. 161 POINTER%=FILE.%(NEST%-1)
  469. 162 NEST%=NEST%-1
  470. 163 ENDOFF%=FALSE%
  471. 164 IF(NEST%>0 OR SUBS%=LAST.S%) GOTO 174
  472. 165 LAST.S%=LAST.S%+1
  473. 166 TEXT$=SUBS$(LAST.S%)
  474. 167 GoSub 301
  475. 168 IF NOT(FOUND%) GOTO 172
  476. 169 FILE.%(NEST%+1)=FIND%:POINTER%=FIND%
  477. 170 NEST%=NEST%+1
  478. 171 GOTO 174
  479. 172 EBUF$="SUBROUTINE ("+TEXT$+") NOT FOUND!"
  480. 173 GoSub 367
  481. 174 IF(NEST%>0) GOTO 140
  482. 175 RETURN
  483. 176     'PARSE-INPUT-LINE
  484. 177 GoSub 334
  485. 178 GoSub 372
  486. 179 IF NOT(LEFT$(TEXT$,1)=SIGN$) GOTO 197
  487. 180 TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  488. 181 IF NOT(TEXT$="if") GOTO 184
  489. 182 GoSub 220
  490. 183 GOTO 196è184 IF NOT(TEXT$="else") GOTO 187
  491. 185 EXPAND%=(EXPAND%=FALSE%)
  492. 186 GOTO 196
  493. 187 IF NOT(TEXT$="end") GOTO 190
  494. 188 EXPAND%=TRUE%
  495. 189 GOTO 196
  496. 190 IF NOT(LEFT$(TEXT$,1)=SIGN$) GOTO 194
  497. 191 TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  498. 192 GoSub 395
  499. 193 GOTO 196
  500. 194 IF NOT(EXPAND%) GOTO 196
  501. 195 GoSub 241
  502. 196 GOTO 205
  503. 197 IF NOT(TEXT$="macro") GOTO 200
  504. 198 GoSub 309
  505. 199 GOTO 205
  506. 200 IF NOT(TEXT$="library") GOTO 203
  507. 201 GoSub 379
  508. 202 GOTO 205
  509. 203 IF NOT(EXPAND% AND I.FILE%=SOURCE%) GOTO 205
  510. 204 PRINT #O.FILE%,BUF$
  511. 205 RETURN
  512. 206     'INSERT-PARAMETERS
  513. 207 LB%=INSTR(1,BUF$,"[")
  514. 208 while (LB%>0)
  515. 209 RB%=INSTR(LB%,BUF$,"]")
  516. 210 IF NOT(RB%>0) GOTO 215
  517. 211 INSERT$=PARM$(PARM%(NEST%-1)+VAL(MID$(BUF$,LB%+1,RB%-LB%)))
  518. 212 BUF$=LEFT$(BUF$,LB%-1)+INSERT$+RIGHT$(BUF$,LEN(BUF$)-RB%)
  519. 213 LB%=INSTR(RB%,BUF$,"[")
  520. 214 GOTO 216
  521. 215 LB%=0
  522. 216 wend
  523. 217 LN.%=LEN(BUF$)
  524. 218 RETURN
  525. 219     'SET-CONDITIONAL
  526. 220 GoSub 334
  527. 221 L$=TEXT$:OP$=""
  528. 222 IF(L$="=" OR L$="#" OR L$="<>")THEN OP$=L$:L$=""
  529. 223 GoSub 334
  530. 224 IF NOT(TEXT$="") GOTO 227
  531. 225 OP$="<>":R$=""
  532. 226 GOTO 231
  533. 227 IF NOT(OP$="") GOTO 231
  534. 228 OP$=TEXT$
  535. 229 GoSub 334
  536. 230 R$=TEXT$
  537. 231 IF NOT(OP$="=") GOTO 234
  538. 232 EXPAND%=(R$=L$)
  539. 233 GOTO 239
  540. 234 IF NOT(OP$="<>" OR OP$="#") GOTO 237
  541. 235 EXPAND%=(R$<>L$)
  542. 236 GOTO 239
  543. 237 EBUF$="ILLEGAL OPERATOR("+OP$+")"
  544. 238 GoSub 367è239 RETURN
  545. 240     'EXPAND-MACRO
  546. 241 GoSub 301
  547. 242 IF NOT(FOUND%) GOTO 250
  548. 243 IF(FILE.%(NEST%)=>0)THEN FILE.%(NEST%)=POINTER%
  549. 244 POINTER%=FIND%
  550. 245 NEST%=NEST%+1
  551. 246 FILE.%(NEST%)=FIND%
  552. 247 PARM%(NEST%)=PARM%(NEST%-1)
  553. 248 GoSub 254
  554. 249 GOTO 252
  555. 250 EBUF$="MACRO ("+TEXT$+") NOT DEFINED."
  556. 251 GoSub 367
  557. 252 RETURN
  558. 253     'LOAD-PARAMETERS
  559. 254 PASS%=FALSE%
  560. 255 while PASS%=FALSE%
  561. 256 PASS%=(CON%=FALSE%)
  562. 257 GoSub 334
  563. 258 while (FIRST%<=LN.%)
  564. 259 PARM%(NEST%)=PARM%(NEST%)+1
  565. 260 PARM$(PARM%(NEST%))=TEXT$
  566. 261 GoSub 334
  567. 262 wend
  568. 263 IF(CON%)THEN GoSub 279
  569. 264 wend
  570. 265 RETURN
  571. 266     'INPUT-BUFFER
  572. 267 IF NOT(FILE.%(NEST%)<0) GOTO 270
  573. 268 GoSub 279
  574. 269 GOTO 277
  575. 270 BUF$=STORE$(POINTER%)
  576. 271 POINTER%=POINTER%+1
  577. 272 ENDOFF%=(BUF$=CHR$(7))
  578. 273 SKIP%=FALSE%
  579. 274 CON%=SKIP%
  580. 275 LN.%=LEN(BUF$)
  581. 276 INDEX%=0
  582. 277 RETURN
  583. 278     'INPUT-SOURCE
  584. 279 INDEX%=0:CON%=FALSE%
  585. 280 LINE INPUT #I.FILE%,BUF$
  586. 281 ENDOFF%=EOF(I.FILE%)
  587. 282 LN.%=LEN(BUF$):I%=1:II%=0
  588. 283 while (I%>II% AND I%<LEN(BUF$))
  589. 284 II%=I%:I%=I%+ABS(MID$(BUF$,I%,1)=" " OR MID$(BUF$,I%,1)=CHR$(9))
  590. 285 wend
  591. 286 II%=LN.%+1
  592. 287 while (II%>LN.% AND LN.%>I%)
  593. 288 II%=LN.%:LN.%=LN.%+(MID$(BUF$,LN.%,1)=" " OR MID$(BUF$,LN.%,1)=CHR$(9))
  594. 289 wend
  595. 290 BUF$=MID$(BUF$,I%,LN.%):LN.%=LEN(BUF$)
  596. 291 SKIP%=(MID$(BUF$,1,1)="'" OR MID$(BUF$,1,1)=";" OR LEN(BUF$)<2)
  597. 292 IF NOT(SKIP%) GOTO 295
  598. 293 LN.%=1è294 GOTO 299
  599. 295 IF NOT(RIGHT$(BUF$,2)="\\") GOTO 299
  600. 296 CON%=TRUE%
  601. 297 BUF$=LEFT$(BUF$,LEN(BUF$)-2)
  602. 298 LN.%=LEN(BUF$)
  603. 299 RETURN
  604. 300     'FIND-MACRO-NAME
  605. 301 FIND%=FALSE%:THIS.M%=0
  606. 302 FOR M%=1 TO LAST.M%
  607. 303 IF(MACRO$(M%)=TEXT$)THEN THIS.M%=M%:M%=LAST.M%+1
  608. 304 NEXT M%
  609. 305 FOUND%=(THIS.M%>0)
  610. 306 IF(FOUND%)THEN FIND%=MACRO%(THIS.M%)
  611. 307 RETURN
  612. 308     'INPUT-A-MACRO
  613. 309 GoSub 334
  614. 310 GoSub 372
  615. 311 GoSub 301
  616. 312 IF NOT(FOUND%) GOTO 315
  617. 313 MACRO%(THIS.M%)=STORE.%+1
  618. 314 GOTO 318
  619. 315 MACRO$(LAST.M%+1)=TEXT$
  620. 316 MACRO%(LAST.M%+1)=STORE.%+1
  621. 317 LAST.M%=LAST.M%+1
  622. 318 GoSub 279
  623. 319 GoSub 334
  624. 320 GoSub 372
  625. 321 while (TEXT$<>"endm" AND ENDOFF%=FALSE%)
  626. 322 IF(SKIP%=FALSE%)THEN GoSub 330
  627. 323 GoSub 279
  628. 324 IF(SKIP%=FALSE%)THEN GoSub 334:GoSub 372
  629. 325 wend
  630. 326 BUF$=CHR$(7)
  631. 327 GoSub 330
  632. 328 RETURN
  633. 329     'STORE-MACRO-CODE
  634. 330 STORE.%=STORE.%+1
  635. 331 STORE$(STORE.%)=BUF$
  636. 332 RETURN
  637. 333     'PARSER
  638. 334 I%=32
  639. 335 while (I%=32)
  640. 336 INDEX%=INDEX%+1
  641. 337 IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  642. 338 I%=I%+(23*ABS(I%=9))
  643. 339 wend
  644. 340 FIRST%=INDEX%
  645. 341 while (I%<>32 AND I%<>7)
  646. 342 IF NOT(I%=44 OR I%=9) GOTO 345
  647. 343 I%=32
  648. 344 GOTO 350
  649. 345 IF NOT(I%=34) GOTO 348
  650. 346 X%=INSTR(INDEX%+1,BUF$,CHR$(34))
  651. 347 IF(X%>INDEX%)THEN INDEX%=X%
  652. 348 INDEX%=INDEX%+1è349 IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  653. 350 wend
  654. 351 TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%)
  655. 352 RETURN
  656. 353     'FILENAMES
  657. 354 LINE INPUT"INPUT FILE [.M]:",I.FILE$
  658. 355 IF(I.FILE$="") GOTO 365
  659. 356 IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  660. 357 LK.$=I.FILE$:LK.%=I.FILE%:GoSub 391:I.FILE%=LK.%
  661. 358 IF(I.FILE%=FALSE%) GOTO 365
  662. 359 I%=INSTR(1,I.FILE$,DOT$)
  663. 360 IF(I%=0)THEN I%=LEN(I.FILE$)+1
  664. 361 FILE$=LEFT$(I.FILE$,I%-1)
  665. 362 LINE INPUT"OUTPUT FILE [.P]:",O.FILE$
  666. 363 IF(O.FILE$="")THEN O.FILE$=FILE$
  667. 364 IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  668. 365 RETURN
  669. 366     'ERRORS
  670. 367 ERRORS%=ERRORS%+1
  671. 368 EBUF$="ERR#"+STR$(ERRORS%)+" ("+EBUF$+")"
  672. 369 PRINT EBUF$
  673. 370 RETURN
  674. 371     'LCASE
  675. 372 I%=1
  676. 373 while (I%<=LEN(TEXT$))
  677. 374 II%=ASC(MID$(TEXT$,I%,1))
  678. 375 MID$(TEXT$,I%,1)=CHR$(II%+(32*ABS(II%>64 AND II%<91))):I%=I%+1
  679. 376 wend
  680. 377 RETURN
  681. 378     'LIBRARY
  682. 379 GoSub 334
  683. 380 IF(TEXT$="") GOTO 389
  684. 381 IF(INSTR(TEXT$,DOT$)=0)THEN TEXT$=TEXT$+LEXT$
  685. 382 LK.%=I.FILE%+1:LK.$=TEXT$:GoSub 391
  686. 383 IF NOT(LK.%>0) GOTO 387
  687. 384 OPEN"I",LK.%,LK.$:I.FILE%=LK.%
  688. 385 NEST%=NEST%+1:FILE.%(NEST%)=-1
  689. 386 GOTO 389
  690. 387 EBUF$="LIBRARY ("+LK.$+") NOT FOUND!"
  691. 388 GoSub 367
  692. 389 RETURN
  693. 390     '_Lookup
  694. 391 OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  695. 392 IF(L.K!<1)THEN LK.%=0:KILL LK.$
  696. 393 RETURN
  697. 394     'SUBROUTINE
  698. 395 S%=0
  699. 396 while (S%<SUBS%)
  700. 397 S%=S%+1:IF(TEXT$=SUBS$(S%))THEN S%=SUBS%+1
  701. 398 wend
  702. 399 IF(S%=SUBS%)THEN SUBS%=SUBS%+1:SUBS$(SUBS%)=TEXT$
  703. 400 RETURN
  705.  
  706. èBINPUT.M
  707.  
  708. '------------------------------------------------------
  709. '-         Standardized Program Shell                 -
  710. '------------------------------------------------------
  711. '- Program:BINPUT
  712. '- System :PPE TOOLS
  713. '- Module :BMLP
  714. '- Task   :EXAMPLE SOURCE TO BE PREPROCESSED BY BMLP & BSLP
  715. '- Created:3.3.85
  716. '- By     :D. L. Bendorf
  717. '- Version:N/A
  718. '- Notes  :LIBRARY <BINPUT.ML>
  719. '- History:               
  720. '-
  721. '------------------------------------------------------
  722. '- ** Data Division                                   -
  723. '------------------------------------------------------
  724. LIBRARY BINPUT
  725. '------------------------------------------------------
  726. T.R%       = 1    'ROW for time display
  727. T.C%       = 50    'COLUMN  
  728. TIMEFLAG%  = 1     'enable time display 
  729. ENTRYFLAG% = 1    'enable keyboard input
  730.  
  731. MACRO DO
  732.     GoSub [1]
  733. ENDM
  734. '------------------------------------------------------
  735. '- ** Procedure Division                              -
  736. '------------------------------------------------------
  737. PROG BINPUT
  738.     $DO Screen
  739.  
  740.     LOOP
  741.         $DO Form
  742.     ENDL WHEN EDITFLAG%<>1 OR ABORTFLAG%<>0
  743.  
  744.     WHEN ABORTFLAG%=0    
  745.         ENTRYFLAG%=0         'Set display mode on
  746.         $DO Form            
  747.         'Go display data
  748.     ENDW
  749. PEND
  750. PROC Form
  751.     REPEAT
  752.         $INPUT 1,NAMES$,8,10,40,"U","E","",NAMES$,"R","",""
  753.         $INPUT 2,AGE$,8,58,2,"N","E","",AGE$,"R","",""
  754.         $INPUT 3,SEX$,8,67,1,"V","E","",SEX$,"MF","",""
  755.         $INPUT 4,ADDRESS$,10,13,25,"U","E","",ADDRESS$,"R","",""
  756.         $INPUT 5,CITY$,10,47,15,"U","E","",CITY$,"R","",""
  757.         $INPUT 6,STATE$,10,71,2,"U","E","",STATE$,"R","",""
  758.         $INPUT 7,ZIPCODE$,12,13,10,"N","E","",ZIPCODE$,"R","",""
  759.         $INPUT 8,PHONE$,12,32,10,"N","E","(???)-???-????",PHONE$,"R","",""
  760.         $INPUT 9,BIRTH$,12,60,6,"D","E","??/??/??",BIRTH$,"R","",""è        EDITFLAG%=0            'Shutoff edit mode
  761.  
  762.         UNLESS ENTRYFLAG%=0
  763.             $PROMPT "Any Changes?","YN"+CHR$(13),EDITFLAG%
  764.             WHO%=1            'Set for field #1 case edit mode
  765.         ENDU
  766.  
  767.     UNTIL EDITFLAG%<>1
  768. ENDP
  769. PROC Screen
  770.     key off
  771.     $Video
  772.     $Frame 6,14,1,79
  773.     $Crt 08,03," Name:",1
  774.     $Crt 08,52," Age:"
  775.     $Crt 08,61," Sex:"
  776.     $Crt 10,03," Address:"
  777.     $Crt 10,40," City:"
  778.     $Crt 10,63," State:"
  779.     $Crt 12,03," ZipCode:"
  780.     $Crt 12,24," Phone:"
  781.     $Crt 12,47," Birth-Date:",,1
  782. ENDP
  783. '------------------------------------------------------
  784. '- ** SubRoutine Division                             -
  785. '------------------------------------------------------
  786.  
  787.  
  788. BINPUT.ML
  789.  
  790. ;;==========================================================================
  791. ; NOTE:
  792. ;         THE `|' VERTICAL BAR IS USED AS A CONTINUATION MARK.
  793. ; DOCUMENTATION ABREVIATIONS:
  794. ;         S/L  =  STRING VARIABLE OR LITERAL ENCLOSED WITH DOUBLE QUOTES.
  795. ;         N/L  =  NUMERIC VARIABLE OR LITERAL.
  796. ;         S    =  STRING VARIABLE ONLY.
  797. ;         N    =  NUMERIC VARIABLE ONLY.         
  798. ;         S/N  =  STRING OR NUMERIC VARIABLE.
  799. ;         
  800. ==========================================================================
  801. ;**
  802. ::INPUT (Macro)
  803. ;**   FUNCTION:
  804. ;**             Standard Terminal Input Subroutine.
  805. ;**   USAGE:
  806. ;**             Twelve parameters required.
  807. ;**     Calling:
  808. ;**                [1]   N/L      -   input order index. 
  809. ;**                [2]   S        -   input/display buffer.
  810. ;**                [3]   N/L      -   cursor row to input-display on.
  811. ;**                [4]   N/L      -   cursor column to input-display on.
  812. ;**                [5]   N/L      -   maximum number of input characters.
  813. ;**                [6]   S/L      -   Editing method:
  814. ;**                                   A - any printable character.è;**                                   N - numbers & minus sign.
  815. ;**                                   D - dates with verification.
  816. ;**                                   Y - allows yes/no with conversion.
  817. ;**                                   V - validate input using [10].
  818. ;**                                   U - convert to upper case.
  819. ;**                [7]   S/L      -   allowable exit method:
  820. ;**                                   E - <End> key = abort.
  821. ;**                [8]   S/L      -   display format, eg.`??/??/??'.
  822. ;**                [9]   S/L      -   default for [2] on carriage return.
  823. ;**                [10]  S/L      -   optional input editing feature:
  824. ;**                                   R - required input if no default.
  825. ;**                                   if [6] = "V" [10] must have
  826. ;**                                   a valid string.
  827. ;**                [11]  S/L      -   lower limit for range of numeric input.
  828. ;**                [12]  S/L      -   upper limit for range of numeric input.
  829. ;**     Returning:
  830. ;**                 [2]           -   has unformatted entry.
  831. ;**                ABORTFLAG%     -   entry has been aborted if non-zero.
  832. ;**                XFK%           -   if non-zero a cursor flag will be set
  833. ;**                                   Cursor Flags:
  834. ;**                                      XU.% - up arrow = prior field.
  835. ;**                                      XD.% - down arrow = next field.
  836. ;**
  837. ;**   EXAMPLE:
  838. ;**            $input 1,a$,8,8,1,"Y","E","","Y","","",""
  839. ;**                a$ ="1" if a `Y' or <CR> was entered.
  840. ;**   NOTE:
  841. ;**     Modes:
  842. ;**             The variable ENTRYFLAG% controls the function mode.
  843. ;**   
  844. ;**             Input:   ENTRYFLAG% = 1 : input from keyboard.
  845. ;**                      EDITFLAG%  = 1 : edit - change the contents of [2].
  846. ;**                                     : WHO% controls which item to edit, 
  847. ;**                                       the contents of [2] is formatted 
  848. ;**                                       and displayed on line 24.
  849. ;**             Display: ENTRYFLAG% = 0 : display the contents of [2].
  850. ;**
  851. ;**            This macro requires the _INPUT subroutine. 
  852. ;**            
  853. ;**
  854. MACRO INPUT
  855.    Unless EDITFLAG%=1 And WHO%<>[1]
  856.       XWH%=[1]|
  857.       XEE$=[2]|
  858.       XRW%=[3]|
  859.       XCL%=[4]|
  860.       XLG%=[5]|
  861.       XTY$=[6]|
  862.       XCT$=[7]|
  863.       XFT$=[8]|
  864.       XDF$=[9]|
  865.       XOP$=[10]|
  866.       XLW$=[11]|
  867.       XHI$=[12]|
  868.       Gosub _Input|è      If(ENTRYFLAG%=1)Then If((XAB%+XU.%)<>0)Then Return Else [2]=XEE$
  869.    Endu
  870. ;**
  871. ;**  Include _INPUT subroutine    
  872.    $$_INPUT
  873. ;**
  874. ENDM
  875. ;;==========================================================================
  876. ;**
  877. ::_INPUT (Subroutine)
  878. ;**   FUNCTION:
  879. ;**             Subroutine for support of the INPUT macro.
  880. ;**
  881. MACRO _INPUT
  882. Proc _Input
  883.    XED%=EDITFLAG%
  884.    Unless ENTRYFLAG%<>1
  885.      Gosub _Input_1:If(XAB%<>0)Then Return
  886.      XED%=Abs((XED%+XU.%+XD.%)<>0):If(XED%)Then WHO%=XWH%+(XU.%=1)+ABS(XD.%=1)
  887.      EDITFLAG%=XED%
  888.    Endu
  889.    XTX$=XEE$:If(XTY$="Y")Then If(XEE$="1")Then XTX$="Y"Else XTX$="N"
  890.    $DISPLAY XRW%,XCL%,XTX$,XFT$
  891. Endp
  892. Proc _Input_1
  893.    XFK%=0|
  894.    XU.%=0|
  895.    XD.%=0|
  896.    XAB%=0|
  897.    XLN%=0|
  898.    XH.!=Val(XHI$)|
  899.    XL.!=Val(XLW$)
  900.    Unless XED%=0 Or Len(XEE$)=0
  901.        $DISPLAY 24,XCL%,XEE$,XFT$
  902.    Endu
  903.    XTX$=XEE$
  904.    Unless Len(XEE$)=0
  905.        XTX$="."+XEE$:While(Right$(XTX$,1)=" "):XTX$=Left$(XTX$,Len(XTX$)-1):Wend| 
  906.        XTX$=Mid$(XEE$,1,Len(XTX$)-1):XLN%=Len(XTX$)
  907.    Endu
  908.    If(Len(XTX$)<XLG%)Then XTX$=XTX$+String$(XLG%-Len(XTX$),176)
  909.    XK$=XEE$:If(Len(XEE$)=0)Then XK$=Space$(XLG%)
  910.    Gosub Locate_Input:Gosub _Input_2:ABORTFLAG%=XAB%
  911.    If(XAB%)Then Return Else If(XLN%>0)Then XEE$=XK$
  912.    XEE$=XEE$+Space$(XLG%-Len(XEE$))
  913. Endp
  914. Proc _Input_2
  915.    XZ.%=0|
  916.    XA.%=0|
  917.    While XA.%+XAB%+XFK%=0
  918.       Gosub _InKey
  919.       When XFK%=0
  920.          When XI.%=8 And XZ.%>0
  921.             Print Chr$(29);Chr$(176);Chr$(29);|
  922.             Mid$(XK$,XZ.%,1)=" "|è            XZ.%=XZ.%-1:XLN%=XLN%-1
  923.          Else Unless XI.%<32 Or XI.%>126
  924.             When XTY$="A" Or XI.%=45 Or (XI.%>47 And XI.%<58)
  925.                Gosub _Input_3
  926.             Else Unless Instr("UVY",XTY$)=0
  927.                XI.$=Chr$(XI.%+(32*(XI.%>96 And XI.%<123)))
  928.                When XTY$="V" And (Instr(XOP$,XI.$)=0)
  929.                   $MSG "Invalid Entry!"
  930.                Else
  931.                   Gosub _Input_3
  932.                Endw
  933.             Else
  934.                Beep
  935.             Endw
  936.          Else Unless XI.%<>13
  937.             Gosub Test_Input
  938.          Else
  939.             Beep
  940.          Endw
  941.       Else
  942.          When XFK%=79 And XCT$="E"
  943.             XAB%=1
  944.          Else
  945.             FK%=XFK%
  946.             Switch XFK%
  947.             Case 82
  948.                XFK%=0:X.$=Mid$(XK$,1,XZ.%)+" ":XLN%=XLN%+1|
  949.                X.$=X.$+Mid$(XK$,XZ.%+1,XLG%):XK$=Mid$(X.$,1,XLG%)|
  950.                Gosub New_Display
  951.                Break
  952.             Case 83
  953.                XFK%=0:XK$=Mid$(XK$,1,XZ.%)+Mid$(XK$,XZ.%+2,XLG%)+" ":XLN%=XLN%-1|
  954.                Gosub New_Display
  955.                Break
  956.             Case 72
  957.                XZ.%=0:Gosub Test_Input:XU.%=XK.%
  958.                Break
  959.             Case 75
  960.                XFK%=0:If(XZ.%>0)Then Print Chr$(29);:XZ.%=XZ.%-1:Else Beep
  961.                Break
  962.             Case 77
  963.                XFK%=0:If(XZ.%<XLG%)Then Print Chr$(28);:XZ.%=XZ.%+1:Else Beep
  964.                Break
  965.             Case 80
  966.                XZ.%=0:Gosub Test_Input:XD.%=XK.%
  967.                Break
  968.             Case FK%
  969.                XFK%=0|
  970.                Beep
  971.             Endc
  972.          Endw
  973.       Endw
  974.    Wend
  975. Endp
  976. Proc Locate_Inputè   If(Len(XFT$)<XLG%)Then XFT%=XLG%-Len(XFT$) Else XFT%=1
  977.    Locate XRW%,XCL%,0:Print Space$(Len(XFT$)+XFT%);:Locate XRW%,XCL%|
  978.    Print XTX$;:Locate XRW%,XCL%
  979. Endp
  980. Proc Test_Input
  981.       XK.%=1
  982.       When XZ.%=0 And XOP$="R" And Len(XEE$)=0 And Len(XDF$)=0
  983.             $MSG "Required Entry!"
  984.             XK.%=0:XFK%=0
  985.       Else
  986.          Gosub _Input_4
  987.       Endw
  988. Endp
  989. Proc New_Display
  990.    XR.%=Csrlin:XC.%=Pos(0):Locate XRW%,XCL%,0:Print Space$(XLG%);|
  991.    Locate XRW%,XCL%:Print Mid$(XK$,1,XLN%);String$(XLG%-XLN%,176);:Locate XR.%,XC.%
  992. Endp
  993. Proc _Input_3
  994.    If(XZ.%+1<=XLG%)Then XZ.%=Pos(0)-XCL%+1:Print XI.$;:Mid$(XK$,XZ.%,1)=XI.$:Else Beep
  995.    If(XZ.%>XLN%)Then XLN%=XZ.%
  996. Endp
  997. Proc _Input_4
  998.    When XZ.%=0 And XED%=0 And Len(XDF$)>0
  999.       XK$=XDF$:XZ.%=Len(XDF$)
  1000.    Endw
  1001.    XE!=Val(XK$)
  1002.    When XTY$="N" Or XTY$="#"
  1003.       XE.%=((XL.!<>0 And XE!<XL.!) Or (XH.!<>0 And XE!>XH.!))
  1004.       When XE.%<>0
  1005.          $MSG "Out of Range!"
  1006.       Else
  1007.          XA.%=1:If(XE!=0)Then XK$="00":XZ.%=2
  1008.       Endw
  1009.    Else
  1010.       When XTY$="Y"
  1011.          XA.%=1:If(XK$="Y" Or XK$="y")Then XK$="1"Else XK$="2"
  1012.       Else When XTY$="D"
  1013.          Unless Val(XK$)<>0
  1014.             X.$=Date$|
  1015.             XM$=Left$(X.$,2)|
  1016.             XD$=Mid$(X.$,4,2)|
  1017.             XY$=Right$(X.$,2)|
  1018.             XK$=XM$+XD$+XY$
  1019.          Endu
  1020.          XM%=Val(Left$(XK$,2))|
  1021.          XD%=Val(Mid$(XK$,3,2))|
  1022.          When XM%<1 Or XM%>12 Or XD%<1 Or XD%>31
  1023.             $MSG "Enter Date Format MMDDYY"
  1024.          Else
  1025.             XA.%=1
  1026.          Endw
  1027.       Else
  1028.          XA.%=1
  1029.       Endw
  1030.    Endwè   Unless XA.%+XFK%=0
  1031.       $MSG ""
  1032.       Locate 24,1:Print Space$(79);
  1033.    Endu
  1034. Endp
  1035. ;**
  1036. ;**  Here are additional supporting subroutines.
  1037.    $$_FORMAT
  1038.    $$_INKEY
  1039. ENDM
  1040. ;;==========================================================================
  1041. ;**
  1042. ::_INKEY (Subroutine)
  1043. ;**   FUNCTION:
  1044. ;**             Get keyboard input one character at a time.
  1045. ;**   USAGE:
  1046. ;**             Cursor should be positioned before calling.
  1047. ;**             The variable XI.% is returned as decimal value or zero
  1048. ;**             if control/function key was entered,
  1049. ;**             in which case the XFK% variable will be the decimal
  1050. :**             value of entry.
  1051. ;**   NOTE:
  1052. ;**             Basic's INKEY$ function is used to return input from keyboard.
  1053. ;**             Time display will be updated if the variable timeflag%
  1054. ;**             is non-zero.
  1055. ;**           
  1056. MACRO _INKEY
  1057. Proc _InKey
  1058.      ;* call the time display subroutine if non-zero.
  1059.    Unless timeflag%=0
  1060.      ;* the following three variables control time display only.
  1061.       XU%=0|
  1062.       XS%=0|
  1063.       Gosub _Time
  1064.    Endu
  1065.      ;* turn on block cursor
  1066.    Locate ,,1,0,13|
  1067.    XI.$=""|
  1068.      ;* loop here waiting for input and updating the time every second.
  1069.    While XI.$=""|
  1070.       If(timeflag%)Then XU%=XU%+1:If(XU%>GT.%)Then Gosub _Time:XU%=0
  1071.       XI.$=Inkey$
  1072.    Wend|
  1073.    XI.%=Asc(XI.$)|
  1074.      ;* return control or function key if first byte=null.
  1075.    If(XI.%=0)Then XFK%=Asc(Right$(XI.$,1)) Else XFK%=0
  1076. Endp
  1077. ;**
  1078. ;**  Include _TIME subroutine.
  1079.    $$_TIME
  1080. ;**
  1081. ENDM
  1082. ;;==========================================================================
  1083. ;**
  1084. ::_TIME (Subroutine)è;**   FUNCTION:
  1085. ;**             Display time-of-day.
  1086. ;**   USAGE:
  1087. ;**             The display location is controlled by the variables
  1088. ;**             T.r% (row) and T.c% (column). 
  1089. ;**             T.r% and T.c% are set prior to calling.
  1090. ;**   NOTE:
  1091. ;**             GT.% is used by _INKEY to control update frequency.
  1092. ;**             GT.% = 60 - for interpreter.
  1093. ;**             GT.% = 1000 - for compiled.
  1094. ;** 
  1095. MACRO _TIME
  1096. Proc _Time
  1097.    XR.%=Csrlin|
  1098.    XC.%=Pos(0)|
  1099.    XT.$=Time$|
  1100.    XH.%=Val(Left$(XT.$,2))|
  1101.    XM.$=" am"
  1102.    Unless XH.%<12
  1103.       XM.$=" pm":XH%=XH.%+(12*(XH.%>12))|
  1104.       XT.$=Str$(XH%)+Right$(XT.$,Len(XT.$)-Len(Str$(XH.%))+1)|
  1105.       If(XH%=12)Then XM.$=" am"
  1106.    Endu
  1107.    Locate ,,0|  
  1108.    Locate T.R%,T.C%|
  1109.    Print XT.$;XM.$;|
  1110.    Locate XR.%,XC.%,1|
  1111.    XS.%=Val(Right$(XT.$,2))|
  1112.       ;* adjust update frequency if compiled.
  1113.    GT.%=60+(940*ABS(XS.%-XS%=0 And XS%>0))|
  1114.    XS%=XS.%
  1115. Endp
  1116. ENDM
  1117. ;;==========================================================================
  1118. ;**
  1119. ::MSG (Macro)
  1120. ;**   FUNCTION:
  1121. ;**             Display message on line 25 and ding the bell.
  1122. ;**   USAGE:
  1123. ;**             One parameter required.
  1124. ;**             [1] - S/L 
  1125. ;**   EXAMPLE:
  1126. ;**             $msg "HELLO WORLD"
  1127. ;**   NOTE:
  1128. ;**             The current cursor location is saved and then restored after
  1129. ;**             message has been displayed.
  1130. ;**
  1131. MACRO MSG
  1132.    X.$=[1]:Gosub _MSG
  1133. ;**
  1134. ;**  Include the _MSG subroutine.
  1135.    $$_MSG
  1136. ;**
  1137. ENDM
  1138. ;;==========================================================================è;**
  1139. ::_MSG (Subroutine)
  1140. ;**   FUNCTION: Subroutine for the MSG macro.
  1141. ;**
  1142. ;**   NOTE:
  1143. ;**             If X.$ is NULL, line 25 is cleared.
  1144. ;**
  1145. MACRO _MSG
  1146. Proc _MSG
  1147.    XR.%=Csrlin|
  1148.    XC.%=Pos(0)|
  1149.    Locate 25,1,0|
  1150.    Print Space$(79);:If Len(X.$)>0 Then Beep:Locate 25,1:Print X.$;
  1151.    Locate XR.%,XC.%
  1152. Endp
  1153. ENDM
  1154. ;;==========================================================================
  1155. ;**
  1156. ::FORMAT (Macro)
  1157. ;**   FUNCTION: 
  1158. ;**             Format a string using a format description.
  1159. ;**   USAGE:
  1160. ;**             Two parameters are required.
  1161. ;**      Calling:
  1162. ;**             [1] - S   -  containing characters to be formatted.
  1163. ;**             [2] - S/L -  containing a format description.
  1164. ;**      Optional:
  1165. ;**             [3] - L   -  L = left justify
  1166. ;**      Returning:
  1167. ;**             [1] - formatted string.
  1168. ;**
  1169. ;**   EXAMPLE:
  1170. ;**             $format NUMBER$,"###,###.##"
  1171. ;**             $format ACCOUNT$,"????-???",L
  1172. ;**
  1173. ;**   NOTE:
  1174. ;**             Format description characters:
  1175. ;**             # - digit (0..9).
  1176. ;**                 default to "0" if right of decimal point. 
  1177. ;**                 default to " " if left of decimal point.
  1178. ;**             Z - digit (0..9).
  1179. ;**                 default to "0" always.
  1180. ;**             ? - wild card.
  1181. ;**                 default to " " always.
  1182. MACRO FORMAT
  1183.    XTF$=[1]:XFF$=[2]:XJ.$="[3]":Gosub _Format:[1]=XTF$
  1184. ;**   Include _FORMAT subroutine
  1185. ;**
  1186.    $$_FORMAT
  1187. ;**
  1188. ENDM
  1189. ;;==========================================================================
  1190. ;**
  1191. ::_FORMAT (Subroutine)
  1192. ;**   FUNCTION:è;**             Supporting subroutine for FORMAT macro.
  1193. ;**
  1194. ;**
  1195. MACRO _FORMAT
  1196. Proc _Format
  1197.    Unless Len(XFF$)=0 Or Len(XTF$)=0
  1198.       XF1%=Len(XTF$)|
  1199.       XF2%=Len(XFF$)|
  1200.       XXF$=Space$(XF2%)|
  1201.       XF3%=Instr(XFF$,".")|
  1202.       XF4%=(XF3%>0 And Instr(XFF$,"#"))
  1203.       While XF2%+XF1%>0
  1204.          When XF2%>0
  1205.             XF.$=Mid$(XFF$,XF2%,1):XF.%=Instr("?#Z",XF.$)
  1206.             Unless XF.%=0
  1207.                When XF1%>0
  1208.                   XF.$=Mid$(XTF$,XF1%,1)|
  1209.                   If(XF.%>1 And Val(XF.$)=0 And XF.$<>"0")Then XF.$="0" Else XF1%=XF1%-1
  1210.                Else
  1211.                   If(XF.%=3)Then XF.$="0"Else XF.$=" "
  1212.                Endw
  1213.             Endu
  1214.             If(XF.$=" " And XF4% And XF3%>0 And XF2%=>XF3%)Then XF.$="0"
  1215.             Mid$(XXF$,XF2%,1)=XF.$:XF2%=XF2%-1
  1216.          Else
  1217.             XXF$=Mid$(XTF$,XF1%,1)+XXF$:XF1%=XF1%-1
  1218.          Endw
  1219.       Wend
  1220.       While Left$(XXF$,1)=" " And XJ.$="L"
  1221.          XXF$=Right$(XXF$,Len(XXF$)-1)
  1222.       Wend
  1223.       XTF$=XXF$ 
  1224.    Endu
  1225. Endp
  1226. ENDM
  1227. ;;==========================================================================
  1228. ;**
  1229. ::DISPLAY (Macro)
  1230. ;**   FUNCTION:
  1231. ;**             Display on CRT.
  1232. ;**   USAGE:
  1233. ;**             Three parameters are required.
  1234. ;**             One optional parameter.
  1235. ;**     Calling:
  1236. ;**             [1] - N/L - display row (1..24).
  1237. ;**             [2] - N/L - display column (1..80).
  1238. ;**             [3] - S/L - containing characters to be displayed. 
  1239. ;**             [4] - S/L - optional format description.
  1240. ;**
  1241. ;**   EXAMPLE:
  1242. ;**             $display 10,20,"HELLO WORLD"
  1243. ;**             $display RW.%,CL.%,SSN$,"???-??-????"
  1244. ;**             $display 11,25,TODAY$,"??/??/??"
  1245. MACRO DISPLAY
  1246.    XD.$=[3]è;**   if the [4] parameter is used
  1247.    $IF [4]
  1248. ;**   formatting is required.
  1249.    $FORMAT XD.$,[4]
  1250.    $END
  1251.    XR.%=[1]:XC.%=[2]
  1252.    Gosub _Display
  1253. ;**   Include _DISPLAY subroutine
  1254.    $$_DISPLAY
  1255. ;**
  1256. ENDM
  1257. ;;==========================================================================
  1258. ;**
  1259. ::_DISPLAY (Subroutine)
  1260. ;**   FUNCTION:
  1261. ;**             Supporting subroutine for DISPLAY macro.
  1262. ;**
  1263. ;**
  1264. MACRO _DISPLAY
  1265. Proc _Display
  1266.    Locate XR.%,XC.%,0|
  1267.    Print Space$(Len(XD.$)+1);|
  1268.    Locate XR.%,XC.%|
  1269.    Print XD.$;
  1270. Endp
  1271. ENDM
  1272. ;;==========================================================================
  1273. ;**
  1274. ::PROMPT (Macro)
  1275. ;**   FUNCTION:
  1276. ;**             Display a prompt on line 25 and get input from keyboard.
  1277. ;**   USAGE:
  1278. ;**             Two parameters required.
  1279. ;**             Two optional parameters.
  1280. ;**     Calling:
  1281. ;**             [1] - S/L - display message.
  1282. ;**             [2] - S/L - input validation string.
  1283. ;**     Returning:
  1284. ;**      Optional- [3] - N   - index value of input in validation string.
  1285. ;**      Optional- [4] - S   - input character.
  1286. ;**
  1287. ;**   EXAMPLE:
  1288. ;**             $prompt "Any Change","YN",ask.%
  1289. ;**             ask.% = 1 if `Y' entered.
  1290. ;**             ask.% = 2 if `N' entered.
  1291. ;**   NOTE:
  1292. ;**             The current cursor location is saved and restored.
  1293. ;**
  1294. MACRO PROMPT
  1295.    $IF [3]
  1296.    PROMPT$=[1]:XX.$=[2]:Gosub _Prompt:[3]=XX.%
  1297.    $ELSE
  1298.    PROMPT$=[1]:XX.$=[2]:Gosub _Prompt
  1299.    $END
  1300.    $IF [4]è   [4]=XI.$
  1301.    $END
  1302. ;**   Include supporting subroutine.
  1303.    $$_PROMPT
  1304. ;**
  1305. ENDM
  1306. ;;==========================================================================
  1307. ;**
  1308. ::_PROMPT (Subroutine)
  1309. ;**   FUNCTION:
  1310. ;**             Supporting subroutine for PROMPT macro.
  1311. ;**
  1312. MACRO _PROMPT
  1313. Proc _Prompt
  1314.    XR.%=Csrlin|
  1315.    XC.%=Pos(0)|
  1316.    locate 25,1,0:Print PROMPT$;:Locate 25,Pos(0)+1,1,0,13:XI.$=""
  1317.    While(XI.$="")
  1318.       Gosub _InKey|
  1319.       XI.$=Chr$(XI.%+(32*(XI.%>96 And XI.%<123)))|
  1320.       XX.%=Instr(XX.$,XI.$)|
  1321.       If(Len(XX.$)>0)Then If(XX.%=0)Then Beep:XI.$=""
  1322.    Wend
  1323.    Locate 25,1,0|
  1324.    Print Space$(79);|
  1325.    Locate XR.%,XC.%
  1326. Endp
  1327. ;**   Include supporting subroutine.
  1328.    $$_INKEY
  1329. ;**
  1330. ENDM
  1331. ;;==========================================================================
  1332. ;**
  1333. ::FRAME (Macro)
  1334. ;**   FUNCTION:
  1335. ;**             Draws a block graphic frame on screen.
  1336. ;**   USAGE:
  1337. ;**             Four parameters required.
  1338. ;**     Calling:
  1339. ;**             [1] - N/L - top row (1..24).
  1340. ;**             [2] - N/L - bottom row (1..24).
  1341. ;**             [3] - N/L - left column (1..80).
  1342. ;**             [4] - N/L - right column (1..80).
  1343. ;**   EXAMPLE:
  1344. ;**             $frame 4,10,20,60
  1345. ;**             $frame TR%,BR%,LC%,RC%
  1346. ;**             
  1347. MACRO FRAME
  1348.    X1.%=[1]:X2.%=[2]:X3.%=[3]:X4.%=[4]:Gosub _Frame
  1349. ;**   Include supporting subroutine.
  1350.    $$_FRAME
  1351. ;**
  1352. ENDM
  1353. ;;==========================================================================
  1354. ;**è::_FRAME (Subroutine)
  1355. ;**   FUNCTION:
  1356. ;**             Called by FRAME macro to do the work.
  1357. ;**             
  1358. MACRO _FRAME
  1359. Proc _Frame
  1360.    Locate X1.%,X3.%,0|
  1361.    Print Chr$(201);String$(X4.%-X3.%-1,205);Chr$(187);
  1362.    For X5.%=X1.%+1 To X2.%-1|
  1363.    Locate X5.%,X3.%:Print Chr$(186);:Locate X5.%,X4.%:Print Chr$(186);|
  1364.    Next
  1365.    Locate X2.%,X3.%|
  1366.    Print Chr$(200);String$(X4.%-X3.%-1,205);Chr$(188);
  1367. Endp
  1368. ENDM
  1369. ;;==========================================================================
  1370. ;**
  1371. ::VIDEO (Macro)
  1372. ;**   FUNCTION:
  1373. ;**             Routine to get CRT memory offset for color or monochrome,
  1374. ;**             and reset screen and color, and clear screen.
  1375. ;**             Screen:
  1376. ;**                   text mode.
  1377. ;**                   color burst set non-zero (if color monitor).
  1378. ;**                   active page zero.
  1379. ;**                   visual page zero.
  1380. ;**             Width:
  1381. ;**                   80.
  1382. ;**             Color:
  1383. ;**                   foreground  = yellow (14).
  1384. ;**                   background  = blue   (1).
  1385. ;**                   border      = blue   (1).
  1386. ;**             Monochrome:
  1387. ;**                   foreground  = white  (7).
  1388. ;**                   background  = black  (0).
  1389. ;**                   border      = black  (0).
  1390. ;**   USAGE:
  1391. ;**             No parameter required.
  1392. ;**     Returning:
  1393. ;**             VIDEO% - offset to CRT memory.
  1394. ;**             MONO%  - true (-1) if monochrome.
  1395. ;**             ADPT%  - true (-1) if color adapter.
  1396. ;**             FG.%   - foreground: 7=monochrome, 14=color.
  1397. ;**             BG.%   - background: 0=monochrome, 1=color.
  1398. ;**             BD.%   - border: same as background (BG.%).
  1399. ;**   NOTE:
  1400. ;**             &HB000=monochrome offset, &HB800=Color offset.
  1401. ;**             If you call this more than once in a program,
  1402. ;**             you should change it to a procedure subroutine,
  1403. ;**             ie..(_VIDEO).
  1404. ;**
  1405. ;**             **(DEF SEG is set to zero by VIDEO).
  1406. ;**             
  1407. MACRO VIDEO
  1408.    Def Seg=0:VIDEO%=&HB000-(&H800*(((Peek(1040) And 48)/16)<3))|è   MONO%=((Peek(&H410) And &H30)=&H30)|
  1409.    ADPT%=Not MONO%|
  1410.    Screen 0,Abs(ADPT%),0,0|
  1411.    Width 80|
  1412.    FG.%=FG.%+(7*ABS(FG.%=0))|
  1413.    FG.%=(FG.%*(1+ABS(ADPT% And FG.%=7)))|
  1414.    BG.%=BG.%+(1*ABS(BG.%=0))|   
  1415.    BG.%=(BG.%+(MONO%*ABS(BG.%=1)))|
  1416.    BD.%=BG.%|
  1417.    Color FG.%,BG.%,BD.%:Cls
  1418. ENDM
  1419. ;;==========================================================================
  1420. ;**
  1421. ::CRT (Macro)
  1422. ;**   FUNCTION:
  1423. ;**             Screen display.
  1424. ;**   USAGE:
  1425. ;**             Three parameters required.
  1426. ;**             [1] - N/L - screen row.
  1427. ;**             [2] - N/L - screen column.
  1428. ;**             [3] - S/L - display buffer.
  1429. ;**             [4] - L   - optional reverse video.
  1430. ;**   EXAMPLE:
  1431. ;**             $crt 12,25,"HELP"
  1432. ;**             $crt RW.%,CL.%,HELP$,1
  1433. ;**
  1434. MACRO CRT
  1435.    $IF [4]
  1436.    Color BG.%,FG.%
  1437.    $END
  1438.    Locate [1],[2]:Print [3];
  1439.    $IF [5] 
  1440.    Color FG.%,BG.%
  1441.    $END
  1442. ENDM
  1443. ;
  1444.  
  1445.  
  1446. BMLP.P
  1447.  
  1448. '-----------------------------------------------------------------------------
  1449. '- (C) Bendorf Associates, 1984-85                                           -
  1450. '-----------------------------------------------------------------------------
  1451. '- Program:BMLP (BASIC MACRO LANGUAGE PREPROCESSOR)
  1452. '- System :PPE 
  1453. '- Module :TOOLS
  1454. '- Task   :EXPAND MACROS USING LOCAL OR LIBRARY DEFINITIONS.
  1455. '- Created:10.1.82
  1456. '- By     :D. L. BENDORF
  1457. '- Version:PUBLIC DOMAIN
  1458. '- Notes  :THIS PROGRAM IS NOT FOR RESALE.
  1459. '- History:
  1460. '-----------------------------------------------------------------------------
  1461. '- ** Data Division                                                          -
  1462. '-----------------------------------------------------------------------------èSIGN$    = "$"
  1463. DOT$     = "."
  1464. OEXT$    = ".P"         ' Output file default extension
  1465. IEXT$    = ".M"         ' Input file default extension
  1466. LEXT$    = ".ML"        ' Library file default extension
  1467. SOURCE%  = 2            ' Input file number
  1468. O.FILE%  = 1            ' Output file number
  1469. I.FILE%  = 2
  1470. ERRORS%  = 0
  1471. FALSE%   = 0
  1472. TRUE%    = NOT FALSE%
  1473. EXPAND%  = TRUE%
  1474. STORE.%  = 0
  1475. NEST%    = 1
  1476. DIM FILE.%(50)      ' TEMPORARY STACK OF POINTERS TO THE NEXT SUBSCRIPT
  1477.                     ' OF STORE$ ARRAY. ALLOWS NESTED MACROS AND LIBRARIES.
  1478. DIM PARM$(500)      ' TEMPORARY STORAGE OF PARAMETERS TO PASS TO MACROS.
  1479. DIM PARM%(100)      ' ARRAY OF POINTERS TO PARAMETER STORAGE.
  1480.  
  1481. DIM MACRO$(100)     ' STORAGE FOR MACRO NAMES.
  1482. DIM MACRO%(100)     ' ARRAY OF POINTERS TO FIRST CODE LOCATION IN STORE$ ARRAY 
  1483.                     ' FOR EACH MACRO NAME IN THE MACRO$ ARRAY. 
  1484. DIM STORE$(1000)    ' STORAGE FOR MACRO TEXT.
  1485. DIM SUBS$(50)       ' STORAGE FOR MACRO SUBROUTINE NAMES.
  1486. '
  1487. '------------------------------------------------------
  1488. '- ** Procedure Division                              -
  1489. '------------------------------------------------------
  1490. '
  1491. prog BMLP
  1492.     PRINT "BMLP   V1.0B (C) BENDORF ASSOCIATES, 1984-85"
  1493.     PRINT
  1494.     GoSub FILENAMES
  1495.     when I.FILE%>0
  1496.         GoSub PROCESS-SOURCE-FILE
  1497.         CLOSE
  1498.         when ERRORS%>0
  1499.             KILL O.FILE$
  1500.             PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  1501.         else
  1502.             PRINT"<";O.FILE$;"> DONE!"
  1503.         endw
  1504.     else when I.FILE$<>""
  1505.         PRINT"CANNOT OPEN ";I.FILE$
  1506.     endw
  1507. pend
  1508. proc PROCESS-SOURCE-FILE
  1509.     OPEN"O",O.FILE%,O.FILE$
  1510.     OPEN"I",I.FILE%,I.FILE$
  1511.     FILE.%(NEST%)=-1
  1512.     loop unless NEST%=0
  1513.         while ENDOFF%=FALSE%
  1514.             GoSub INPUT-BUFFER
  1515.             when LN.%>1 AND ENDOFF%=FALSE%
  1516.                 GoSub INSERT-PARAMETERSè                GoSub PARSE-INPUT-LINE
  1517.             else when SKIP% AND I.FILE%=SOURCE%
  1518.                 PRINT #O.FILE%,BUF$
  1519.             endw
  1520.         wend
  1521.         IF(NEST%=1)THEN FIRST%=0 ELSE FIRST%=PARM%(NEST%-1)
  1522.         LAST%=PARM%(NEST%) 
  1523.         PARM%(NEST%)=0
  1524.         while (FIRST%<LAST%)
  1525.             PARM$(LAST%)=""
  1526.             LAST%=LAST%-1
  1527.         wend
  1528.         when FILE.%(NEST%)<0 AND NEST%>1 AND I.FILE%>SOURCE%
  1529.             CLOSE #I.FILE%
  1530.             I.FILE%=I.FILE%-1
  1531.         else
  1532.             POINTER%=FILE.%(NEST%-1)
  1533.         endw
  1534.         NEST%=NEST%-1
  1535.         ENDOFF%=FALSE%
  1536.         unless NEST%>0 OR SUBS%=LAST.S%
  1537.             LAST.S%=LAST.S%+1
  1538.             TEXT$=SUBS$(LAST.S%)
  1539.             GoSub FIND-MACRO-NAME
  1540.             when FOUND%
  1541.                 FILE.%(NEST%+1)=FIND%:POINTER%=FIND%
  1542.                 NEST%=NEST%+1
  1543.             else
  1544.                 EBUF$="SUBROUTINE ("+TEXT$+") NOT FOUND!"
  1545.                 GoSub ERRORS
  1546.             endw
  1547.         endu
  1548.     endl unless NEST%>0
  1549. endp
  1550. '
  1551. '------------------------------------------------------
  1552. '- ** SubRoutine Division                             -
  1553. '------------------------------------------------------
  1554. '
  1555. proc PARSE-INPUT-LINE
  1556.     GoSub PARSER
  1557.     GoSub LCASE
  1558.     when LEFT$(TEXT$,1)=SIGN$
  1559.         TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  1560.         when TEXT$="if"
  1561.             GoSub SET-CONDITIONAL
  1562.         else when TEXT$="else" 
  1563.             EXPAND%=(EXPAND%=FALSE%)
  1564.         else when TEXT$="end"
  1565.             EXPAND%=TRUE%
  1566.         else when LEFT$(TEXT$,1)=SIGN$
  1567.             TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-1)
  1568.             GoSub SUBROUTINE
  1569.         else when EXPAND%
  1570.             GoSub EXPAND-MACROè        endw
  1571.     else when TEXT$="macro"
  1572.         GoSub INPUT-A-MACRO
  1573.     else when TEXT$="library"
  1574.         GoSub LIBRARY
  1575.     else when EXPAND% AND I.FILE%=SOURCE%
  1576.         PRINT #O.FILE%,BUF$
  1577.     endw
  1578. endp
  1579. proc INSERT-PARAMETERS
  1580.     LB%=INSTR(1,BUF$,"[")
  1581.     while (LB%>0)
  1582.         RB%=INSTR(LB%,BUF$,"]")
  1583.         when RB%>0
  1584.             INSERT$=PARM$(PARM%(NEST%-1)+VAL(MID$(BUF$,LB%+1,RB%-LB%)))
  1585.             BUF$=LEFT$(BUF$,LB%-1)+INSERT$+RIGHT$(BUF$,LEN(BUF$)-RB%)
  1586.             LB%=INSTR(RB%,BUF$,"[")
  1587.         else
  1588.             LB%=0
  1589.         endw
  1590.     wend
  1591.     LN.%=LEN(BUF$)
  1592. endp
  1593. proc SET-CONDITIONAL
  1594.     GoSub PARSER
  1595.     L$=TEXT$:OP$=""
  1596.     IF(L$="=" OR L$="#" OR L$="<>")THEN OP$=L$:L$=""
  1597.     GoSub PARSER
  1598.     when TEXT$="" 
  1599.         OP$="<>":R$=""
  1600.     else when OP$=""
  1601.         OP$=TEXT$
  1602.         GoSub PARSER
  1603.         R$=TEXT$
  1604.     endw
  1605.     when OP$="="
  1606.         EXPAND%=(R$=L$)
  1607.     else when OP$="<>" OR OP$="#"
  1608.         EXPAND%=(R$<>L$)
  1609.     else
  1610.         EBUF$="ILLEGAL OPERATOR("+OP$+")"
  1611.         GoSub ERRORS
  1612.     endw
  1613. endp
  1614. proc EXPAND-MACRO
  1615.     GoSub FIND-MACRO-NAME
  1616.     when FOUND%
  1617.         IF(FILE.%(NEST%)=>0)THEN FILE.%(NEST%)=POINTER%
  1618.         POINTER%=FIND%
  1619.         NEST%=NEST%+1
  1620.         FILE.%(NEST%)=FIND%
  1621.         PARM%(NEST%)=PARM%(NEST%-1)
  1622.         GoSub LOAD-PARAMETERS
  1623.     else
  1624.         EBUF$="MACRO ("+TEXT$+") NOT DEFINED."è        GoSub ERRORS
  1625.     endw
  1626. endp
  1627. proc LOAD-PARAMETERS
  1628.     PASS%=FALSE%
  1629.     while PASS%=FALSE%
  1630.         PASS%=(CON%=FALSE%)
  1631.         GoSub PARSER
  1632.         while (FIRST%<=LN.%)
  1633.             PARM%(NEST%)=PARM%(NEST%)+1
  1634.             PARM$(PARM%(NEST%))=TEXT$
  1635.             GoSub PARSER
  1636.         wend
  1637.         IF(CON%)THEN GoSub INPUT-SOURCE
  1638.     wend
  1639. endp
  1640. proc INPUT-BUFFER
  1641.     when FILE.%(NEST%)<0
  1642.         GoSub INPUT-SOURCE
  1643.     else
  1644.         BUF$=STORE$(POINTER%)
  1645.         POINTER%=POINTER%+1
  1646.         ENDOFF%=(BUF$=CHR$(7))
  1647.         SKIP%=FALSE%
  1648.         CON%=SKIP%
  1649.         LN.%=LEN(BUF$)
  1650.         INDEX%=0
  1651.     endw
  1652. endp
  1653. proc INPUT-SOURCE
  1654.     INDEX%=0:CON%=FALSE%
  1655.     LINE INPUT #I.FILE%,BUF$
  1656.     ENDOFF%=EOF(I.FILE%)
  1657.     LN.%=LEN(BUF$):I%=1:II%=0
  1658.     while (I%>II% AND I%<LEN(BUF$))
  1659.         II%=I%:I%=I%+ABS(MID$(BUF$,I%,1)=" " OR MID$(BUF$,I%,1)=CHR$(9))
  1660.     wend
  1661.     II%=LN.%+1
  1662.     while (II%>LN.% AND LN.%>I%)
  1663.         II%=LN.%:LN.%=LN.%+(MID$(BUF$,LN.%,1)=" " OR MID$(BUF$,LN.%,1)=CHR$(9))
  1664.     wend
  1665.     BUF$=MID$(BUF$,I%,LN.%):LN.%=LEN(BUF$)
  1666.     SKIP%=(MID$(BUF$,1,1)="'" OR MID$(BUF$,1,1)=";" OR LEN(BUF$)<2)
  1667.     when SKIP%
  1668.         LN.%=1
  1669.     else when RIGHT$(BUF$,2)="\\"
  1670.         CON%=TRUE%
  1671.         BUF$=LEFT$(BUF$,LEN(BUF$)-2)
  1672.         LN.%=LEN(BUF$)
  1673.     endw
  1674. endp
  1675. proc FIND-MACRO-NAME
  1676.     FIND%=FALSE%:THIS.M%=0
  1677.     FOR M%=1 TO LAST.M%
  1678.         IF(MACRO$(M%)=TEXT$)THEN THIS.M%=M%:M%=LAST.M%+1è    NEXT M%
  1679.     FOUND%=(THIS.M%>0)
  1680.     IF(FOUND%)THEN FIND%=MACRO%(THIS.M%)
  1681. endp
  1682. proc INPUT-A-MACRO
  1683.     GoSub PARSER
  1684.     GoSub LCASE
  1685.     GoSub FIND-MACRO-NAME
  1686.     when FOUND%
  1687.         MACRO%(THIS.M%)=STORE.%+1
  1688.     else
  1689.         MACRO$(LAST.M%+1)=TEXT$
  1690.         MACRO%(LAST.M%+1)=STORE.%+1
  1691.         LAST.M%=LAST.M%+1
  1692.     endw
  1693.     GoSub INPUT-SOURCE
  1694.     GoSub PARSER
  1695.     GoSub LCASE
  1696.     while (TEXT$<>"endm" AND ENDOFF%=FALSE%)
  1697.         IF(SKIP%=FALSE%)THEN GoSub STORE-MACRO-CODE
  1698.         GoSub INPUT-SOURCE
  1699.         IF(SKIP%=FALSE%)THEN GoSub PARSER:GoSub LCASE
  1700.     wend
  1701.     BUF$=CHR$(7)
  1702.     GoSub STORE-MACRO-CODE
  1703. endp
  1704. proc STORE-MACRO-CODE
  1705.     STORE.%=STORE.%+1
  1706.     STORE$(STORE.%)=BUF$
  1707. endp
  1708. proc PARSER
  1709.     I%=32
  1710.     while (I%=32)
  1711.         INDEX%=INDEX%+1
  1712.         IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  1713.         I%=I%+(23*ABS(I%=9))
  1714.     wend
  1715.     FIRST%=INDEX%
  1716.     while (I%<>32 AND I%<>7)
  1717.         when I%=44 OR I%=9
  1718.             I%=32 
  1719.         else 
  1720.             when I%=34
  1721.                 X%=INSTR(INDEX%+1,BUF$,CHR$(34))
  1722.                 IF(X%>INDEX%)THEN INDEX%=X%
  1723.             endw
  1724.             INDEX%=INDEX%+1
  1725.             IF(INDEX%<=LEN(BUF$))THEN I%=ASC(MID$(BUF$,INDEX%,1)) ELSE I%=7
  1726.         endw
  1727.     wend
  1728.     TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%)
  1729. endp
  1730. proc FILENAMES
  1731.     LINE INPUT"INPUT FILE [.M]:",I.FILE$
  1732.     unless I.FILE$=""è        IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  1733.         LK.$=I.FILE$:LK.%=I.FILE%:GoSub _Lookup:I.FILE%=LK.%
  1734.         unless I.FILE%=FALSE%
  1735.             I%=INSTR(1,I.FILE$,DOT$)
  1736.             IF(I%=0)THEN I%=LEN(I.FILE$)+1
  1737.             FILE$=LEFT$(I.FILE$,I%-1)
  1738.             LINE INPUT"OUTPUT FILE [.P]:",O.FILE$
  1739.             IF(O.FILE$="")THEN O.FILE$=FILE$
  1740.             IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  1741.         endu
  1742.     endu
  1743. endp
  1744. proc ERRORS
  1745.     ERRORS%=ERRORS%+1
  1746.     EBUF$="ERR#"+STR$(ERRORS%)+" ("+EBUF$+")"
  1747.     PRINT EBUF$
  1748. endp
  1749. proc LCASE
  1750.     I%=1
  1751.     while (I%<=LEN(TEXT$))
  1752.         II%=ASC(MID$(TEXT$,I%,1))
  1753.         MID$(TEXT$,I%,1)=CHR$(II%+(32*ABS(II%>64 AND II%<91))):I%=I%+1
  1754.     wend
  1755. endp
  1756. proc LIBRARY
  1757.     GoSub PARSER
  1758.     unless TEXT$=""
  1759.         IF(INSTR(TEXT$,DOT$)=0)THEN TEXT$=TEXT$+LEXT$
  1760.         LK.%=I.FILE%+1:LK.$=TEXT$:GoSub _Lookup
  1761.         when LK.%>0
  1762.             OPEN"I",LK.%,LK.$:I.FILE%=LK.%
  1763.             NEST%=NEST%+1:FILE.%(NEST%)=-1
  1764.         else
  1765.             EBUF$="LIBRARY ("+LK.$+") NOT FOUND!"
  1766.             GoSub ERRORS
  1767.         endw
  1768.     endu
  1769. endp
  1770. proc _Lookup
  1771.     OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  1772.     IF(L.K!<1)THEN LK.%=0:KILL LK.$
  1773. endp
  1774. proc SUBROUTINE
  1775.     S%=0
  1776.     while (S%<SUBS%)
  1777.         S%=S%+1:IF(TEXT$=SUBS$(S%))THEN S%=SUBS%+1
  1778.     wend
  1779.     IF(S%=SUBS%)THEN SUBS%=SUBS%+1:SUBS$(SUBS%)=TEXT$
  1780. endp
  1781.